home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ttedit / toolbar.bas < prev    next >
BASIC Source File  |  1994-11-28  |  15KB  |  442 lines
  1. Option Explicit
  2.  
  3. Dim ButtonCount As Integer
  4. Dim StatusText As String   ' The statusbar caption
  5.  
  6. Dim Parents() As Form  ' the parent form of each button
  7. Dim Menus() As Menu  'array of menus each button is linked to
  8.  
  9. Const BUTTONS_DOWN = 100
  10. Const BUTTONS_DISABLED = 200
  11. Global Const RIGHT_JUSTIFY_BUTTONS = -2
  12. Global Const SPACE_BETWEEN_BUTTONS = -1
  13.  
  14. ' Flags for monitoring ToolTips
  15. Dim TT_Control As Control
  16. Dim TT_CurrentWindow  As Integer
  17. Dim TT_StartTime As Long
  18. Dim TT_Visible As Integer
  19. Dim TT_Point As PointAPI
  20. Dim TT_LastDisplayed As Long
  21.  
  22. Function BaseButton (Index As Integer) As Integer
  23.      BaseButton = Index
  24.      If Index >= BUTTONS_DISABLED Then
  25.     BaseButton = Index - BUTTONS_DISABLED
  26.      ElseIf Index >= BUTTONS_DOWN Then
  27.     BaseButton = Index - BUTTONS_DOWN
  28.      End If
  29. End Function
  30.  
  31. '
  32. ' This loop generates the Disabled and Down images ready for use.
  33. '
  34. Sub Create_OtherButtons (ButtonParent As Form, PicBox As PictureBox, BC As Integer, Start As Integer, Finish As Integer)
  35.    ButtonCount = BC
  36.    ReDim Preserve Parents(ButtonCount)
  37.    ReDim Preserve Menus(ButtonCount)
  38.    Dim X As Integer
  39.    For X = Start To Finish
  40.        PicBox.Picture = ButtonParent.ToolButton(X).Picture
  41.        PushDown PicBox
  42.        Load ButtonParent.ToolButton(BUTTONS_DOWN + X)
  43.        ButtonParent.ToolButton(BUTTONS_DOWN + X).Left = ButtonParent.ToolButton(X).Left
  44.        ButtonParent.ToolButton(BUTTONS_DOWN + X).Top = ButtonParent.ToolButton(X).Top
  45.        ButtonParent.ToolButton(BUTTONS_DOWN + X).Tag = ButtonParent.ToolButton(X).Tag
  46.        ButtonParent.ToolButton(BUTTONS_DOWN + X).Picture = PicBox.Image
  47.        PicBox.Picture = ButtonParent.ToolButton(X).Picture
  48.        PicBox.Cls
  49.        DisableButton PicBox
  50.        Load ButtonParent.ToolButton(BUTTONS_DISABLED + X)
  51.        ButtonParent.ToolButton(BUTTONS_DISABLED + X).Left = ButtonParent.ToolButton(X).Left
  52.        ButtonParent.ToolButton(BUTTONS_DISABLED + X).Top = ButtonParent.ToolButton(X).Top
  53.        ButtonParent.ToolButton(BUTTONS_DISABLED + X).Tag = ButtonParent.ToolButton(X).Tag
  54.        ButtonParent.ToolButton(BUTTONS_DISABLED + X).Picture = PicBox.Image
  55.        Set Parents(X) = ButtonParent
  56.    Next
  57. End Sub
  58.  
  59. '
  60. ' This actually creates the Disabled image from the Up image.
  61. ' We need a picture box for this to work
  62. '
  63. Private Sub DisableButton (Button As PictureBox)
  64.  
  65.  Dim SX1 As Integer
  66.  Dim SX2 As Integer
  67.  Dim SY1 As Integer
  68.  Dim SY2 As Integer
  69.  Dim DX As Integer
  70.  Dim DY As Integer
  71.  Dim R As Integer
  72.  Dim LR As Long
  73.  Dim rgbFace As Long
  74.  Dim rgbShadow As Long
  75.  Dim rgbHilight As Long
  76.  Dim rgbFrame As Long
  77.  Dim Dest_hDC As Integer
  78.  Dim hdcMono As Integer
  79.  Dim hbmMono As Integer
  80.  Dim hbmTemp As Integer
  81.  Dim hbmDefault  As Integer
  82.  Dim hdcTemp As Integer
  83.  Dim hbr As Integer
  84.  Dim hbrOld As Integer
  85.   
  86.  
  87.   SX1 = 1
  88.   SY1 = 1
  89.   SX2 = Button.ScaleWidth - 3
  90.   SY2 = Button.ScaleHeight - 3
  91.   DX = 1
  92.   DY = 1
  93.  
  94.   Dest_hDC = Button.hDC
  95.   rgbFace = GetSysColor(COLOR_BTNFACE)
  96.   rgbShadow = GetSysColor(COLOR_BTNSHADOW)
  97.   rgbHilight = GetSysColor(COLOR_BTNHIGHLIGHT)
  98.   rgbFrame = GetSysColor(COLOR_WINDOWFRAME)
  99.   hdcTemp = CreateCompatibleDC(Dest_hDC)
  100.   hbmTemp = CreateCompatibleBitmap(Dest_hDC, SX2 - SX1 + 1, SY2 - SY1 + 1)
  101.   
  102.   hdcMono = CreateCompatibleDC(Dest_hDC)
  103.   hbmMono = CreateBitmap(SX2 - SX1 + 1, SY2 - SY1 + 1, 1, 1, ByVal 0&)
  104.   R = SelectObject(hdcMono, hbmMono)
  105.   R = SelectObject(hdcTemp, hbmTemp)
  106.   
  107.   R = BitBlt(hdcTemp, DX, DY, SX2 - SX1 + 1, SY2 - SY1 + 1, Dest_hDC, SX1, SY1, SRCCOPY)
  108.   
  109.   R = PatBlt(hdcMono, DX, DY, SX2 - SX1 + 1, SY2 - SY1 + 1, WHITENESS)
  110.   LR = SetBkColor(hdcTemp, rgbFace)     ' // 1's in mono -> 1
  111.   R = BitBlt(hdcMono, DX, DY, SX2 - SX1 + 1, SY2 - SY1 + 1, hdcTemp, SX1, SY1, SRCCOPY)
  112.   LR = SetBkColor(hdcTemp, rgbHilight)  ' // 1's in mono -> 1
  113.   R = BitBlt(hdcMono, DX, DY, SX2 - SX1 + 1, SY2 - SY1 + 1, hdcTemp, SX1, SY1, SRCPAINT)
  114.   LR = SetTextColor(Dest_hDC, &H0)  '      // 0's in mono -> 0 (for ROP)
  115.   LR = SetBkColor(Dest_hDC, &HFFFFFF) ' // 1's in mono -> 1
  116.  
  117.   hbr = CreateSolidBrush(rgbHilight)
  118.   hbrOld = SelectObject(Dest_hDC, hbr)
  119.   R = BitBlt(Dest_hDC, DX + 1, DY + 1, SX2 - SX1 + 1, SY2 - SY1 + 1, hdcMono, SX1, SY1, &HB8074A)
  120.   
  121.   R = SelectObject(Dest_hDC, hbrOld)
  122.   R = DeleteObject(hbr)
  123.   '     // Gray out picture
  124.   hbr = CreateSolidBrush(rgbShadow)
  125.   hbrOld = SelectObject(Dest_hDC, hbr)
  126. '       // Draw the shadow color where we have 0's in the mask.
  127.   
  128.   R = BitBlt(Dest_hDC, DX, DY, SX2 - SX1 + 1, SY2 - SY1 + 1, hdcMono, SX1, SY1, &HB8074A)
  129.   R = SelectObject(Dest_hDC, hbrOld)
  130.   R = DeleteObject(hbr)
  131.   
  132.   R = DeleteDC(hdcMono)
  133.   R = DeleteDC(hdcTemp)
  134.   R = DeleteObject(hbmMono)
  135.   R = DeleteObject(hbmTemp)
  136.  
  137.   Button.Refresh
  138. End Sub
  139.  
  140. Private Sub DisplayHelp (Help$)
  141.     If Len(Help$) Then   ' Double check help$
  142.     ' Make sure help form is invisible:
  143.      frmToolTip.Hide
  144.  
  145.      ' Change caption of label:
  146.      frmToolTip.Label1.Caption = Help$
  147.  
  148.      ' Offset the form from the cursor
  149.      frmToolTip.Top = (TT_Point.Y + TT_Control.Height + 10) * Screen.TwipsPerPixelY
  150.      frmToolTip.Left = TT_Point.X * Screen.TwipsPerPixelX
  151.  
  152.      frmToolTip.Width = (frmToolTip.Label1.Width + 6) * Screen.TwipsPerPixelX
  153.      frmToolTip.Height = (frmToolTip.Label1.Height + 2) * Screen.TwipsPerPixelY
  154.  
  155.      If Screen.Width < frmToolTip.Width + frmToolTip.Left Then frmToolTip.Left = Screen.Width - 1.1 * frmToolTip.Width
  156.         
  157.      ' Make sure form is on top:
  158.      frmToolTip.ZOrder
  159.  
  160.      ' Show form without the focus:
  161.      If ShowWindow(frmToolTip.hWnd, SW_SHOWNOACTIVATE) Then
  162.      End If
  163.      TT_Visible = True
  164.       Else
  165.      ' Hide the form:
  166.      frmToolTip.Hide
  167.      TT_Visible = False
  168.       End If
  169. End Sub
  170.  
  171. Private Sub EnableButton (Button As PictureBox)
  172.     Button.Cls
  173.     Button.Refresh
  174.     Button.Enabled = True
  175. End Sub
  176.  
  177. Function GetButtonState (Index As Integer)
  178.    GetButtonState = Menus(Index).Checked
  179. End Function
  180.  
  181. '
  182. ' This calculates the number we need to use in the Sendmessage to
  183. ' Click the linked menu
  184. '
  185. Function GetMenuIndex (mnu As Menu) As Integer
  186.    Dim X As Integer, Index  As Integer
  187.    Dim F As Form
  188.    Set F = mnu.Parent
  189.    For X = 0 To F.Controls.Count - 1
  190.      If TypeOf F.Controls(X) Is Menu Then Exit For
  191.    Next
  192.    Do While Not F.Controls(X + Index) Is mnu
  193.       Index = Index + 1
  194.    Loop
  195.    GetMenuIndex = Index + 1
  196. End Function
  197.  
  198. Function GetMenuTag (Index As Integer) As String
  199.     If Not Menus(Index) Is Nothing Then GetMenuTag = Menus(Index).Tag
  200. End Function
  201.  
  202. Sub LinkMenu (ButtonID As Integer, mnu As Menu)
  203.    Set Menus(ButtonID) = mnu
  204. End Sub
  205.  
  206. Sub PositionButtons (Positions() As Integer, ToolBar As Control)
  207.    ' We need to position the buttons because the position of buttons cannot be
  208.    ' guaranteed when run on machines with Large screen fonts if designed in small fonts mode.
  209.    Dim X As Integer
  210.    Dim Direction As Integer
  211.    Dim Next_Left As Integer
  212.    Dim LastToolButton
  213.    For X = 0 To UBound(Positions)
  214.      Select Case Positions(X)
  215.        Case RIGHT_JUSTIFY_BUTTONS
  216.     Direction = RIGHT_JUSTIFY_BUTTONS
  217.     Next_Left = ToolBar.ScaleWidth - ToolBar.Parent.ToolButton(LastToolButton).Width
  218.        Case SPACE_BETWEEN_BUTTONS
  219.     If Direction <> RIGHT_JUSTIFY_BUTTONS Then
  220.        Next_Left = Next_Left + ToolBar.Parent.ToolButton(0).Width / 3
  221.     Else
  222.        Next_Left = Next_Left - ToolBar.Parent.ToolButton(0).Width / 3
  223.     End If
  224.        Case Else
  225.     LastToolButton = Positions(X)
  226.     ToolBar.Parent.ToolButton(Positions(X)).Left = Next_Left
  227.     ToolBar.Parent.ToolButton(Positions(X) + BUTTONS_DOWN).Left = Next_Left
  228.     ToolBar.Parent.ToolButton(Positions(X) + BUTTONS_DISABLED).Left = Next_Left
  229.     If Direction <> RIGHT_JUSTIFY_BUTTONS Then
  230.        Next_Left = Next_Left + ToolBar.Parent.ToolButton(Positions(X)).Width
  231.     Else
  232.        Next_Left = Next_Left - ToolBar.Parent.ToolButton(Positions(X)).Width
  233.     End If
  234.      End Select
  235.    Next
  236. End Sub
  237.  
  238. Private Sub PushDown (PicBox As PictureBox)
  239.      Dim X As Integer
  240.      Dim mWidth As Integer
  241.      Dim mHeight As Integer
  242.      PicBox.Cls
  243.      mHeight = PicBox.ScaleHeight
  244.      mWidth = PicBox.ScaleWidth
  245.      
  246.      ' The next 3 lines chang